home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor1
/
frac.src
< prev
next >
Wrap
Text File
|
1990-10-09
|
10KB
|
452 lines
%%HP: T(3)A(D)F(.);
@ by Dave Vomocil
\<<
@ Each mixed number is a list of size three.
3 \->LIST 4 ROLLD 3 \->LIST SWAP
@ Check that both denom's are non-zero.
DUP2 3 GET SWAP 3 GET AND IF NOT
THEN
440 .5 BEEP
"PLUS: zero in denom" 1 DISP 1 FREEZE
ELSE
64 R\->B 131 R\->B BLANK PICT STO @ Blank a 64X131 PICT
@ Display the first addend
SWAP 0 DISPL SWAP
@ Now figure out where to place the + sign
1 GETI SWAP DROP \->STR SIZE 2 + 6 * NEG 65 + R\->B
20 R\->B 2 \->LIST PICT SWAP
" + " 3 \->GROB @ GOR the + sign into PICT
GOR
@ And now the second addend
15 DISPL
25 R\->B 30 R\->B 2 \->LIST
85 R\->B 30 R\->B 2 \->LIST LINE
@ ADD the two mixed numbers and DISPL the sum.
@ Compute LCM of denominators
DUP 3 GET 3 ROLL DUP 3 GET 3 ROLL LCM 0 DUP \-> lcm numer carry
\<<
@ Compute numerator of fraction 1
2 GETI 3 ROLLD GETI SWAP DROP
lcm SWAP / 3 ROLL * 'numer' STO
@ Compute numerator of fraction 2 and add
SWAP 2 GETI 3 ROLLD GETI SWAP DROP
lcm SWAP / 3 ROLL * numer + 'numer' STO
@ Check for carry and reduce fraction part
numer lcm / IP 'carry' STO
numer lcm MOD 'numer' STO
numer lcm GCD DUP
@ Reduce if non-zero GCD
DUP IF THEN
numer SWAP / 'numer' STO
lcm SWAP / 'lcm' STO
ELSE
DROP2
END
@ Add the whole numbers and the carry
1 GET SWAP 1 GET + carry +
@ Form the mixed number list
numer lcm 3 \->LIST
\>> @ end of scope of lcm numer and carry
@ DISPL the result
32 DISPL
@ Convert the list to elements on the stack.
OBJ\-> DROP
END
\>> 'PLUS' STO
\<<
@ Convert elements on the stack to two lists
3 \->LIST 4 ROLLD 3 \->LIST SWAP
@ Check that both denom's are non-zero.
DUP2 3 GET SWAP 3 GET AND IF NOT
THEN
440 .5 BEEP
"SUBTR: zero in denom" 1 DISP 1 FREEZE
ELSE
64 R\->B 131 R\->B BLANK PICT STO @ Blank a 64X131 PICT
@ Display the first minuend
SWAP 0 DISPL SWAP
@ Now figure out where to place the - sign
1 GETI SWAP DROP \->STR SIZE 2 + 6 * NEG 65 + R\->B
20 R\->B 2 \->LIST PICT SWAP
" - " 3 \->GROB @ GOR the + sign into PICT
GOR
@ And now the second subtrahend
15 DISPL
25 R\->B 30 R\->B 2 \->LIST
85 R\->B 30 R\->B 2 \->LIST LINE
@ ADD the two mixed numbers and DISPL the sum.
@ Compute LCM of denominators
DUP 3 GET 3 ROLL DUP 3 GET 3 ROLL LCM 0 DUP \-> lcm numer borrow
\<<
@ Compute numerator of fraction 1
2 GETI 3 ROLLD GETI SWAP DROP
lcm SWAP / 3 ROLL * 'numer' STO
@ Compute numerator of fraction 2
SWAP 2 GETI 3 ROLLD GETI SWAP DROP
lcm SWAP / 3 ROLL * numer SWAP - DUP
@ Determine if we need to borrow
WHILE 0 <
REPEAT lcm + DUP 'borrow' 1 STO+ END
'numer' STO
@ Reduce fraction part
numer lcm GCD DUP
@ Reduce if non-zero GCD
DUP IF THEN
numer SWAP / 'numer' STO
lcm SWAP / 'lcm' STO
ELSE
DROP2
END
@ Subtract the whole numbers
SWAP 1 GET SWAP 1 GET - borrow -
@ Form the mixed number list
numer lcm 3 \->LIST
\>> @ end of scope of lcm numer and carry
@ DISPL the result
32 DISPL
@ Convert the list to elements on the stack
OBJ\-> DROP
END
\>> 'SUBTR' STO
\<<
@ Compute LCM of denominators
DUP 3 GET 3 ROLL DUP 3 GET 3 ROLL LCM 0 DUP \-> lcm numer carry
\<<
@ Compute numerator of fraction 1
2 GETI 3 ROLLD GETI SWAP DROP
lcm SWAP / 3 ROLL * 'numer' STO
@ Compute numerator of fraction 2 and add
SWAP 2 GETI 3 ROLLD GETI SWAP DROP
lcm SWAP / 3 ROLL * numer + 'numer' STO
@ Check for carry and reduce fraction part
numer lcm / IP 'carry' STO
numer lcm MOD 'numer' STO
numer lcm GCD DUP
@ Reduce if non-zero GCD
DUP IF THEN
numer SWAP / 'numer' STO
lcm SWAP / 'lcm' STO
ELSE
DROP2
END
@ Add the whole numbers and the carry
1 GET SWAP 1 GET + carry +
@ Form the mixed number list
numer lcm 3 \->LIST
\>> @ end of scope of lcm numer and carry
\>> 'ADD' STO
\<<
@ Convert the elements on the stack to two lists.
3 \->LIST 4 ROLLD 3 \->LIST SWAP
@ Check that both denom's are non-zero.
DUP2 3 GET SWAP 3 GET AND IF NOT
THEN
440 .5 BEEP
"SUBTR: zero in denom" 1 DISP 1 FREEZE
ELSE
64 R\->B 131 R\->B BLANK PICT STO @ Blank a 64X131 PICT
@ Display the first mmultiplier
SWAP 0 DISPL SWAP
@ Now figure out where to place the * sign
1 GETI SWAP DROP \->STR SIZE 2 + 6 * NEG 65 + R\->B
20 R\->B 2 \->LIST PICT SWAP
" * " 3 \->GROB @ GOR the + sign into PICT
GOR
@ And now the second multiplier
15 DISPL
25 R\->B 30 R\->B 2 \->LIST
85 R\->B 30 R\->B 2 \->LIST LINE
@ Multiply the two mixed numbers and DISPL the sum.
@ Convert the two mixed numbers to improper fractions.
3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
SWAP DROP 2 SWAP PUTI DROP
SWAP
3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
SWAP DROP 2 SWAP PUTI DROP
@ Multiply numerators and denominators
2 GETI 4 ROLLD GET 3 ROLLD
2 GETI 3 ROLLD GET
SWAP 4 ROLL * 3 ROLLD * \-> denom numer
\<<
denom numer GCD
@ Reduce if non-zero GCD
DUP IF THEN
DUP
numer SWAP / 'numer' STO
denom SWAP / 'denom' STO
ELSE
DROP
END
@ Convert from an improper fraction to a mixed number
numer denom / IP
numer denom MOD
denom
@ Form the mixed number list
3 \->LIST
\>> @ end of scope of denom and numer
@ DISPL the result
32 DISPL
@ Convert the list to three elements on the stack
OBJ\-> DROP
END
\>> 'MULTI' STO
\<<
@ Convert elements on the stack to two lists.
3 \->LIST 4 ROLLD 3 \->LIST SWAP
@ Check that both denom's are non-zero.
DUP2 3 GET SWAP 3 GET AND IF NOT
THEN
440 .5 BEEP
"DIVI: zero in denom" 1 DISP 1 FREEZE
ELSE
64 R\->B 131 R\->B BLANK PICT STO @ Blank a 64X131 PICT
@ Display the dividend
SWAP 5 DISPL SWAP
@ Now figure out where to place the divide sign
1 GETI SWAP DROP \->STR SIZE 3 + 6 * NEG 65 + R\->B
25 R\->B 2 \->LIST PICT SWAP
" / " 3 \->GROB
GOR
@ And now the divisor
20 DISPL
25 R\->B 35 R\->B 2 \->LIST
85 R\->B 35 R\->B 2 \->LIST LINE
@ Multiply the two mixed numbers and DISPL the sum.
@ Convert the two mixed numbers to improper fractions.
3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
SWAP DROP 2 SWAP PUT
SWAP
3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
SWAP DROP 2 SWAP PUT
SWAP
@ Invert the quotient
3 GETI 3 ROLLD DROP 2 GETI PUT SWAP 2 SWAP PUT
@ Multiply numerators and denominators
2 GETI 4 ROLLD GET 3 ROLLD
2 GETI 3 ROLLD GET
4 ROLL * 3 ROLLD * \-> denom numer
\<<
denom numer GCD
@ Reduce if non-zero GCD
DUP IF THEN
DUP
numer SWAP / 'numer' STO
denom SWAP / 'denom' STO
ELSE
DROP
END
@ Convert from an improper fraction to a mixed number
numer denom / IP
numer denom MOD
denom
@ Form the mixed number list
3 \->LIST
\>> @ end of scope of denom and numer
@ DISPL the result
37 DISPL
@ Convert the list to elements on the stack
OBJ\-> DROP
END
\>> 'DIVI' STO
@ Computes the lcm using the
@ lcm(m,n) * gcd(m,n) = m * n
\<<
DUP2 AND
IF @ Check for 0 in the arguments.
THEN
@ Compute m * n then the GCD and finally divide
DUP2 * 3 ROLLD GCD /
ELSE
@ Else return a zero
DROP2 0
END
\>> 'LCM' STO
@ This uses Euclid's algorithm to compute the gcd.
@ Euclid's algorithm as Stan remembered it is:
@ If you want the gcd of m and n, then iterate the following:
@ First express m as q0*n + r0
@ then express n as q1*r0 +r1
@ iterate rn as q(n+2)*r(n+1) + r(n+2)
@ when r(n+2) == 0 then r(n+1) is the gcd.
\<<
DUP2 AND @ Check for a 0 in the arguments
IF
THEN
@ Apply Euclid's algorithm
DO DUP 3 ROLLD MOD DUP UNTIL NOT END DROP
ELSE
@ Return a zero if a 0 was in the arguments.
DROP2 0
END
\>> 'GCD' STO
\<<
0 DUP \-> row len midp @ Grab the display row to use
@ and set up a couple locals
\<<
@ First handle the whole number
@ Display the whole number only if it is non-zero
@ or the fraction is zero
1 GETI 3 ROLLD GETI SWAP DROP NOT 3 ROLL OR
IF THEN
1 GETI \->STR
DUP SIZE 'len' STO @ save the length
3 \->GROB @ Get the whole number to a GROB
PICT SWAP @ GOR it into the PICT
65 len 6 * - R\->B row 4 + R\->B 2 \->LIST
SWAP GOR
ELSE 2 END
@ Now for the fraction part.
@ First check the numerator. If it's zero we're done.
@ Otherwise ...
@ computer the width of the fraction
GETI DUP IF THEN
\->STR SIZE 'len' STO
GETI \->STR SIZE len MAX 4 * 2 / 'midp' STO
DROP 2
@ Now place the numerator in the PICT
GETI \->STR
DUP SIZE 'len' STO @ Save the length
1 \->GROB PICT SWAP
len 2 * NEG midp +
66 + R\->B row R\->B 2 \->LIST
SWAP GOR
@ Now the fraction bar
65 R\->B row 6 + R\->B 2 \->LIST
65 midp 2 * + R\->B row 6 + R\->B 2 \->LIST LINE
@ Finally the denominator
GETI \->STR DUP SIZE 'len' STO
1 \->GROB
PICT SWAP
len 2 * NEG midp +
66 + R\->B row 8 + R\->B 2 \->LIST
SWAP GOR
ELSE DROP END
@ Display the result
0 R\->B DUP 2 \->LIST PVIEW 3 FREEZE
DROP @ DROP the GETI index
\>> @ end scope of row and a couple locals
\>> 'DISPL' STO
@ Displays the 'fraction' on the top of the stack
\<<
3 \->LIST DUP 3 GET
IF NOT
THEN
440 .5 BEEP "DISP: zero in denom"
1 DISP 1 FREEZE
ELSE
64 R\->B 131 R\->B BLANK PICT STO
20 DISPL OBJ\-> DROP
END
\>> 'DPLAY' STO
\<<
6 ROLL 6 ROLL 6 ROLL
\>> 'SWAPR' STO
{ S DPLAY 35.2
SWAPR 36.2 DIVI
65.1 MULTI 75.1
SUBTR 85.1 PLUS
95.1 } STOKEYS